home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MACD 5
/
MACD 5.bin
/
workbench
/
blankery
/
blitzblank
/
sources
/
bb.spot
< prev
next >
Wrap
Text File
|
1993-09-17
|
11KB
|
464 lines
;BB.Spot - Blanker-module for BlitzBlank
;Copyright 1993 by Thomas Boerkel
CloseEd
NoCli
NEWTYPE.table
r.l
g.l
b.l
End NEWTYPE
NEWTYPE.tags
a.l
b
c
d
e
f
End NEWTYPE
NEWTYPE.spritedata
a.w
b
c
d
e
f
End NEWTYPE
DEFTYPE.Screen *fs,*myscreen,*myscreen2,*myscreen3
DEFTYPE.ViewPort *vp
DEFTYPE.RastPort *rp
DEFTYPE.ColorMap *cm
DEFTYPE.NewScreen newscreen
DEFTYPE.Message *msg
DEFTYPE.table tab
DEFTYPE.MsgPort *port
DEFTYPE.tags tags
DEFTYPE.spritedata *sprdata
DEFTYPE.SimpleSprite spr
DEFTYPE.Window *mywindow
DEFTYPE.NewWindow newwindow
DEFTYPE.l
Statement stringborder{x,y,w,h}
Wline x+1,y+h+2,x+1,y,x+w+8,y,1
Wline x+w+10,y-1,x+w+10,y+h+4,x-1,y+h+4,1
Wline x,y+h+3,x,y,1
Wline x+w+11,y-1,x+w+11,y+h+4,1
Wline x-1,y+h+3,x-1,y-1,x+w+10,y-1,2
Wline x+w+9,y,x+w+9,y+h+3,x+1,y+h+3,2
Wline x-2,y+h+4,x-2,y-1,2
Wline x+w+8,y+1,x+w+8,y+h+2,2
End Statement
Select Par$(1)
Case "BLANK"
;Delay_ 100
name$="BB.BlankModule"+Chr$(0)
*port=CreateMsgPort_()
*port\mp_Node\ln_Name=&name$
*port\mp_Node\ln_Pri=1
AddPort_ *port
SetTaskPri_ FindTask_(0),Val(Par$(8))
*sprdata=AllocMem_(SizeOf.spritedata,#MEMF_CHIP|#MEMF_CLEAR)
newwindow\LeftEdge=0,0,1,1
newwindow\Flags=#WFLG_ACTIVATE
newwindow\FirstGadget=0,0,0,0,0,-1,-1,-1,-1,#WBENCHSCREEN
*mywindow=OpenWindow_(newwindow)
VWait
SetPointer_ *mywindow,*sprdata,0,0,0,0
Gosub readconfig
If s=3 Then s=4
lib$="intuition.library"+Chr$(0)
*ibase.IntuitionBase=OpenLibrary_(&lib$,39)
CloseLibrary_ *ibase
If *ibase
v39=1
Else
*ibase.IntuitionBase=OpenLibrary_(&lib$,37)
CloseLibrary_ *ibase
EndIf
*fs=*ibase\FirstScreen
left=*fs\LeftEdge
top=*fs\TopEdge
width=*fs\Width
height=*fs\Height
modeid=GetVPModeID_(*fs\ViewPort)
depth=*fs\BitMap\Depth
*cm=*fs\ViewPort\ColorMap
title$="BB.Spot0"+Chr$(0)
newscreen\LeftEdge=left,top,width,height,depth+1
newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title$
tags\a=#SA_DisplayID
tags\b=modeid
tags\c=0
*myscreen=OpenScreenTagList_(newscreen,tags)
If spots>1
title2$="BB.Spot1"+Chr$(0)
newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title2$
*myscreen2=OpenScreenTagList_(newscreen,tags)
EndIf
If *myscreen=0 OR (spots>1 AND *myscreen2=0)
newscreen\LeftEdge=0,0,width,height,1,1,2
newscreen\Type=#CUSTOMSCREEN
*myscreen=OpenScreenTagList_(newscreen,tags)
If *myscreen
VWait
ChangeSprite_ 0,spr,*sprdata
SetRGB4_ *myscreen\ViewPort,0,0,0,0
WaitPort_ *port
*msg=GetMsg_(*port)
CloseScreen_ *myscreen
EndIf
Else
gy=gx*height/width*1.15
cmax=2^depth
title3$="BB.Spot2"+Chr$(0)
newscreen\LeftEdge=0,0,gx+4*s,gy+4*s,depth+1
newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title3$
*myscreen3=OpenScreenTagList_(newscreen,tags)
*rp3.RastPort=*myscreen3\RastPort
*buf=AllocMem_((gx+4*s)*(gy+4*s)/8+100,#MEMF_CHIP|#MEMF_CLEAR)
InitTmpRas_ tmpras.TmpRas,*buf,(gx+4*s)*(gy+4*s)/8+100
buf$=String$(" ",50)
*ai.AreaInfo=AllocMem_(SizeOf.AreaInfo,#MEMF_CLEAR)
InitArea_ *ai.AreaInfo,&buf$,3
*rp3\TmpRas=tmpras
*rp3\AreaInfo=*ai
SetAPen_ *rp3,cmax
AreaEllipse_ *rp3,gx/2+s*2,gy/2+s*2,gx/2,gy/2
AreaEnd_ *rp3
FreeMem_ *ai,SizeOf.AreaInfo
FreeMem_ *buf,(gx+4*s)*(gy+4*s)/8+100
b2=*myscreen3\BitMap
Dim b1(2)
b0=*fs\BitMap
b1(0)=*myscreen\BitMap
FindScreen 0,"BB.Spot0"
If spots>1
b1(1)=*myscreen2\BitMap
*vp2=*myscreen2\ViewPort
FindScreen 1,"BB.Spot1"
EndIf
gx=gx+4*s
gy=gy+4*s
*vp=*myscreen\ViewPort
*rp=*myscreen\RastPort
BltBitMap_ b0,0,0,b1(0),0,0,width,height,$C0,2^depth-1,0
If spots>1 Then BltBitMap_ b0,0,0,b1(1),0,0,width,height,$C0,2^depth-1,0
USEPATH tab
For i=0 To cmax-1
If v39
GetRGB32_ *cm,i,1,tab
SetRGB32_ *vp,cmax+i,tab\r,tab\g,tab\b
If spots>1 Then SetRGB32_ *vp2,cmax+i,tab\r,tab\g,tab\b
\r=(\r AND 255)*fade/100
\g=(\g AND 255)*fade/100
\b=(\b AND 255)*fade/100
\r|\r LSL 8|\r LSL 16|\r LSL 24
\g|\g LSL 8|\g LSL 16|\g LSL 24
\b|\b LSL 8|\b LSL 16|\b LSL 24
SetRGB32_ *vp,i,\r,\g,\b
If spots>1 Then SetRGB32_ *vp2,i,\r,\g,\b
Else
c=GetRGB4_(*cm,i)
r=(c LSR 8) AND 15
g=(c LSR 4) AND 15
b=c AND 15
SetRGB4_ *vp,cmax+i,r,g,b
If spots>1 Then SetRGB4_ *vp2,cmax+i,r,g,b
r*fade/100
g*fade/100
b*fade/100
SetRGB4_ *vp,i,r,g,b
If spots>1 Then SetRGB4_ *vp2,i,r,g,b
EndIf
Next i
ScreenToFront_ *myscreen
Dim x.q(spots+1)
Dim y.q(spots+1)
Dim dx.q(spots+1)
Dim dy.q(spots+1)
For i=1 To spots
x(i)=width/2-gx/2
y(i)=height/2-gy/2
fdummy.q=Rnd(2*s*10)/10
dx(i)=fdummy-s
fdummy=Rnd(2*s*10)/10
dy(i)=fdummy-s
Next i
Repeat
If spots=1
VWait
EndIf
If spots>1
For i=1 To spots
BltBitMap_ b2,0,0,b1(sc),Int(x(i)),Int(y(i)),gx,gy,$00,cmax,0
Next i
EndIf
For i=1 To spots
If Int(Rnd(20/s))=0
Gosub newd
EndIf
If y(i)+dy(i)<0 OR y(i)+dy(i)+gy>height-1
dy(i)=-dy(i)
EndIf
If x(i)+dx(i)<0 OR x(i)+dx(i)+gx>width-1
dx(i)=-dx(i)
EndIf
x(i)+dx(i)
y(i)+dy(i)
pos=y(i)+gy/2+100
If spots=1 AND smooth=2 AND y(i)<gy
Repeat
Until VBeamPos_()>pos
EndIf
If update
BltBitMap_ b0,Int(x(i)),Int(y(i)),b1(sc),Int(x(i)),Int(y(i)),gx,gy,$C0,$FF,0
EndIf
If spots>1
BltBitMap_ b2,0,0,b1(sc),Int(x(i)),Int(y(i)),gx,gy,$E0,cmax,0
Else
BltBitMap_ b2,0,0,b1(sc),Int(x(i)),Int(y(i)),gx,gy,$C0,cmax,0
EndIf
Next i
If spots>1
ShowScreen sc
sc=1-sc
EndIf
*msg=GetMsg_(*port)
Until *msg
CloseScreen_ *myscreen3
CloseScreen_ *myscreen2
CloseScreen_ *myscreen
EndIf
ClearPointer_ *mywindow
CloseWindow_ *mywindow
FreeMem_ *sprdata,SizeOf.spritedata
RemPort_ *port
DeleteMsgPort_ *port
Case "INFO"
title$="Spot"+Chr$(0)
reqtext$="Spot - Module for BlitzBlank"+Chr$(10)
reqtext$+Chr$(169)+" 1993 by Thomas Brkel"+Chr$(10)+Chr$(10)
reqtext$+"Spotlights move over your actual screen."+Chr$(10)+Chr$(10)
reqtext$+"Choose speed, size, number, fading, update, smoothing"+Chr$(10)
reqtext$+"in the config-window."+Chr$(0)
gadget$="OK"+Chr$(0)
easy.EasyStruct\es_StructSize=SizeOf.EasyStruct
easy\es_Title=&title$
easy\es_TextFormat=&reqtext$
easy\es_GadgetFormat=&gadget$
EasyRequestArgs_ 0,easy,0,0
Case "CONFIG"
*myscreen=LockPubScreen_(0)
width=*myscreen\Width
height=*myscreen\Height
font=*myscreen\Font\ta_YSize
Gosub readconfig
WbToScreen 0
BorderPens 0,0
StringGadget 0,180,25,0,4,5,40
StringGadget 0,180,50,0,5,5,40
StringGadget 0,180,75,0,6,5,40
SetString 0,4,Str$(gx)
SetString 0,5,Str$(spots)
SetString 0,6,Str$(fade)
BorderPens 2,1
TextGadget 0,20,105,1,3," Update "
TextGadget 0,20,135,1,7," Smooth "
ButtonGroup 1
TextGadget 0,20,25,512,0," Slow "
TextGadget 0,20,50,512,1," Normal "
TextGadget 0,20,75,512,2," Fast "
Toggle 0,s-1,On
If update
Toggle 0,3,On
EndIf
If smooth=2
Toggle 0,7,On
EndIf
Window 0,width/2-125,height/2-80,250,160,$100e,"Spot",1,2,0
stringborder{180,25,40,8}
stringborder{180,50,40,8}
stringborder{180,75,40,8}
WColour 2
WLocate 105,24-font
Print "Size:"
WLocate 105,24-font+8
Print "(10-150)"
WLocate 105,49-font
Print "Number:"
WLocate 105,49-font+8
Print "(1-100)"
WLocate 105,74-font
Print "Fade to:"
WLocate 105,74-font+8
Print "(0-99)"
ActivateString 0,4
If update=1
Disable 0,6
Redraw 0,6
stringborder{180,75,40,8}
EndIf
Repeat
ev=WaitEvent
If ev=$40
Select GadgetHit
Case 3
If GadgetStatus(0,3)
update=1
Disable 0,6
Redraw 0,6
stringborder{180,75,40,8}
Else
update=0
Enable 0,6
Redraw 0,6
stringborder{180,75,40,8}
EndIf
Case 4
ActivateString 0,5
Case 5
If update=0
ActivateString 0,6
Else
e=1
EndIf
Case 6
e=1
End Select
EndIf
Until ev=$200 OR e
s=ButtonId(0,1)+1
If GadgetStatus(0,7)
smooth=2
Else
smooth=1
EndIf
gx=Val(StringText$(0,4))
spots=Val(StringText$(0,5))
If update=0
fade=Val(StringText$(0,6))
Else
fade=0
EndIf
Free Window 0
Gosub writeconfig
UnlockPubScreen_ 0,*myscreen
End Select
End
.readconfig
path$=Par$(9)
For i=10 To NumPars
path$=path$+" "+Par$(i)
Next i
If ReadFile(0,path$+"BB.Modules.config")
FileInput 0
While NOT Eof(0)
If Edit$(100)="*** Spot ***"
s=Val(Edit$(5))
update=Val(Edit$(5))
gx=Val(Edit$(5))
spots=Val(Edit$(5))
fade=Val(Edit$(5))
smooth=Val(Edit$(5))
EndIf
Wend
DefaultInput
CloseFile 0
EndIf
Gosub checkval
Return
.writeconfig
Gosub checkval
If ReadFile(0,path$+"BB.Modules.config")
If WriteFile(1,path$+"BB.Modules.temp")
FileInput 0
FileOutput 1
While NOT Eof(0)
f$=Edit$(100)
If f$="*** Spot ***"
Repeat
f2$=Edit$(100)
Until Eof(0) OR Left$(f2$,3)="***"
If NOT Eof(0) Then NPrint f2$
Else
NPrint f$
EndIf
Wend
CloseFile 1
EndIf
CloseFile 0
EndIf
KillFile path$+"BB.Modules.config"
f$=path$+"BB.Modules.temp"+Chr$(0)
f2$=path$+"BB.Modules.config"+Chr$(0)
Rename_ &f$,&f2$
If OpenFile(0,path$+"BB.Modules.config")
FileOutput 0
FileSeek 0,Lof(0)
NPrint "*** Spot ***"
NPrint s
NPrint update
NPrint gx
NPrint spots
NPrint fade
NPrint smooth
CloseFile 0
EndIf
Return
.checkval
If s<1 Then s=1
If s>3 Then s=3
If update<0 Then update=0
If update>1 Then update=1
If spots<1 Then spots=1
If spots>100 Then spots=100
If gx<10 Then gx=100
If gx>150 Then gx=100
If fade<0 Then fade=0
If fade>99 Then fade=99
If smooth<1 Then smooth=1
If smooth>2 Then smooth=1
Return
.newd
ddx.q=(Int(Rnd(3))-1)/4
ddy.q=(Int(Rnd(3))-1)/4
If NOT((dx(i)+ddx<>0 OR dy(i)+ddy<>0) AND Abs(dx(i)+ddx)<=s AND Abs(dx(i)+ddx)>=s/3)
ddx=-ddx
EndIf
If NOT((dx(i)+ddx<>0 OR dy(i)+ddy<>0) AND Abs(dy(i)+ddy)<=s AND Abs(dy(i)+ddy)>=s/3)
ddy=-ddy
EndIf
dx(i)+ddx
dy(i)+ddy
Return